Shareware Grab Bag/Shareware Grab Bag.iso/007/x68000.arc/SOURCE.ARC/CODEGENE.MOD

Modula Implementation | 1986-03-04 | 34.5 KB | 1,057 lines

IMPLEMENTATION MODULE CodeGenerator;
(* Uses information supplied by Parser, OperationCodes, *)
(* and SyntaxAnalyzer to produce the object code.       *)

   FROM Strings IMPORT
      Length, CompareStr;

   FROM SymbolTable IMPORT
      FillSymTab, ReadSymTab;

   FROM Parser IMPORT
      TOKEN, OPERAND, OpLoc, SrcLoc, DestLoc;

   FROM LongNumbers IMPORT
      LONG, LongAdd, LongSub, LongInc, LongDec,
      LongClear, CardToLong, LongToCard, LongToInt,
      LongCompare, AddrBoundW, AddrBoundL;

   FROM OperationCodes IMPORT
      ModeTypeA, ModeTypeB, ModeA, ModeB, Instructions;

   FROM ErrorX68 IMPORT
      ErrorType, Error;

   FROM SyntaxAnalyzer IMPORT
      SizeType, OpConfig, OpMode, Xtype,
      GetValue, GetSize, GetInstModeSize, GetOperand, GetMultReg;


   CONST
      JMP = {14, 11, 10, 9, 7, 6};
      JSR = {14, 11, 10, 9, 7};
      RTE = {14, 11, 10, 9, 6, 5, 4, 1, 0};
      RTR = {14, 11, 10, 9, 6, 5, 4, 2, 1, 0};
      RTS = {14, 11, 10, 9, 6, 5, 4, 2, 0};
      TRAPV = {14, 11, 10, 9, 6, 5, 4, 2, 1};
      STOP = {14, 11, 10, 9, 6, 5, 4, 1};
      LINK = {14, 11, 10, 9, 6, 4};
      SWAP = {14, 11, 6};
      UNLK = {14, 11, 10, 9, 6, 4, 3};
      Quote = 47C;


   VAR
   (*---
      (* Defined in DEFINITION MODULE *)
      LZero, AddrCnt : LONG;
      Pass2 : BOOLEAN;
                                       ---*)
      AddrAdv : LONG;
      TempL : LONG;     (* Temporary variables *)
      TempI : INTEGER;
      TempC : CARDINAL;
      BrValue : LONG;   (* Used to calculate relative branches *)
      RevBr : BOOLEAN;
      Quick : BOOLEAN;   (* Used by MergeModes *)
      Size : SizeType;       (* size for OpCode *)
      InstSize : CARDINAL;
      AddrModeA : ModeA;     (* Addressing modes for this instruction *)
      AddrModeB : ModeB;     (*               ditto                   *)
      Op : BITSET;           (* Raw bit pattern for OpCode *)
      Src, Dest : OpConfig;




   PROCEDURE BuildSymTable (VAR AddrCnt : LONG;
                            Label, OpCode : TOKEN; SrcOp, DestOp : OPERAND);
   (* Builds symbol table from symbolic information of Source File *)

      VAR
         Value : LONG;
         Full : BOOLEAN;
         PseudoOp : BOOLEAN;

      BEGIN
         Value := LZero;
         AddrAdv := LZero;
         InstSize := 0;
         PseudoOp := FALSE;
         Size := S0;

         IF Length (OpCode) = 0 THEN
            RETURN;   (* Nothing added to symbol table, AddrCnt not changed *)
         END;

         GetSize (OpCode, Size);

         IF CompareStr (OpCode, "ORG") = 0 THEN
            GetValue (SrcOp, AddrCnt);
            AddrBoundW (AddrCnt);
            Value := AddrCnt;
            PseudoOp := TRUE;
         ELSIF CompareStr (OpCode, "EQU") = 0 THEN
            GetValue (SrcOp, Value);
            PseudoOp := TRUE;
         ELSIF CompareStr (OpCode, "DC") = 0 THEN
            CASE Size OF
               Word  :  AddrBoundW (AddrCnt);
            |  Long  :  AddrBoundL (AddrCnt);
            |  Byte  :  ;
            END;

            IF SrcOp[0] = Quote THEN   (* String Constant *)
               TempC := Length (SrcOp);
               IF TempC > 2 THEN
                  InstSize := TempC - 2;
               END;
            ELSE
               InstSize := ORD (Size);
            END;
            CardToLong (InstSize, AddrAdv);
            Value := AddrCnt;
            PseudoOp := TRUE;
         ELSIF CompareStr (OpCode, "DS") = 0 THEN
            GetValue (SrcOp, AddrAdv);
            Value := AddrCnt;
            PseudoOp := TRUE;
         ELSIF CompareStr (OpCode, "EVEN") = 0 THEN
            AddrBoundW (AddrCnt);
            Value := AddrCnt;
            PseudoOp := TRUE;
         ELSIF CompareStr (OpCode, "END") = 0 THEN
            PseudoOp := TRUE;
         ELSE
            Value := AddrCnt;
         END;

         IF Length (Label) # 0 THEN
            FillSymTab (Label, Value, Full);
            IF Full THEN
               Error (0, SymFull);
            END;
         END;

         IF NOT PseudoOp THEN
            Instructions (OpCode, OpLoc, Op, AddrModeA, AddrModeB);

            AddrBoundW (AddrCnt);
            Src.Loc := SrcLoc;   Dest.Loc := DestLoc;
            GetOperand (SrcOp, Src);
            GetOperand (DestOp, Dest);
            InstSize := 2;   (* minimum size of instruction *)

            IF Brnch IN AddrModeA THEN
               IF Size # Byte THEN
                  INC (InstSize, 2);
               END;
            ELSIF DecBr IN AddrModeA THEN
               INC (InstSize, 2);
            ELSE
               IF (Op = JMP) OR (Op = JSR) THEN   (* Allows for 'JMP.S' *)
                  IF (Size = Byte) AND (Src.Mode = AbsL) THEN
                     Src.Mode := AbsW;
                  END;
               END;

               TempC := GetInstModeSize (Src.Mode, Size, InstSize);
               TempC := GetInstModeSize (Dest.Mode, Size, InstSize);
            END;

            IF (Src.Mode = Imm) AND
             ((Data911 IN AddrModeA) OR (Data03 IN AddrModeA) OR
              (Data07 IN AddrModeA) OR (CntR911 IN AddrModeA)) THEN
               (* Quick instruction *)
               InstSize := 2;
            END;
            CardToLong (InstSize, AddrAdv);
         END;
      END BuildSymTable;




   PROCEDURE OperExt (VAR EA : OpConfig);
   (* Calculate Operand Extension word, and check range of Operands *)

      VAR
         GoodInt : BOOLEAN;
         Xext : BITSET;

      BEGIN
         GoodInt := LongToInt (EA.Value, TempI);

         CASE EA.Mode OF
            AbsL     :  ;   (* No range checking needed *)
         |  AbsW     :  IF NOT GoodInt THEN
                           Error (EA.Loc, SizeErr);
                        END;
         |  ARDisp,
            PCDisp   :  IF NOT GoodInt THEN
                           Error (EA.Loc, SizeErr);
                        END;
         |  ARDisX,
            PCDisX   :  IF (TempI < -128) OR (TempI > 127) THEN
                           Error (EA.Loc, SizeErr);
                        END;
                        Xext := BITSET (EA.Xn * 4096);
                        IF EA.X = Areg THEN
                           Xext := Xext + {15};
                        END;
                        IF EA.Xsize = Long THEN
                           Xext := Xext + {11};
                        END;
                        CardToLong (CARDINAL (Xext), TempL);
                        EA.Value[3] := TempL[3];
                        EA.Value[4] := TempL[4];
         |  Imm      :  IF Size = Long THEN
                           (* No range check needed *)
                        ELSE
                           IF GoodInt THEN
                              IF Size = Byte THEN
                                 IF (TempI < -128) OR (TempI > 127) THEN
                                    Error (EA.Loc, SizeErr);
                                 END;
                              END;
                           ELSE
                              Error (EA.Loc, SizeErr);
                           END;
                        END;
         ELSE
            (* No Action *)
         END;
      END OperExt;



   PROCEDURE EffAdr (VAR EA : OpConfig; Bad : BITSET);
   (* adds effective address field to Op (BITSET representing opcode) *)

      VAR
         M : CARDINAL;

      BEGIN
         M := ORD (EA.Mode);

         IF M IN Bad THEN
            Error (EA.Loc, ModeErr);
            RETURN;
         ELSIF M > 11 THEN
            RETURN;
         ELSIF M < 7 THEN
            Op := Op + BITSET (M * 8) + BITSET (EA.Rn);
         ELSE   (*    7  <=  M  <=  11   *)
            Op := Op + {5, 4, 3} + BITSET (M - 7);
         END;

         OperExt (EA);
      END EffAdr;



   CONST
      (* BITSETs of the modes MISSING from effective address modes  *)
       ea = {};                 (* Effective addressing - all modes *)
      dea = {1};                (* Data effective addressing        *)
      mea = {1, 0};             (* Memory effective addressing      *)
      cea = {11, 4, 3, 1, 0};   (* Control effective addressing     *)
      aea = {11, 10, 9};        (* Alterable effective addressing   *)
      xxx = {15, 14, 13};       (* extra modes: CCR/SR/USP          *)
      (* 2 "AND" masks to turn off switch bits for shift/rotate *)
      Off910 = {15, 14, 13, 12, 11, 8, 7, 6, 5, 4, 3, 2, 1, 0};
      Off34 = {15, 14, 13, 12, 11, 10, 9, 8, 7, 6, 5, 2, 1, 0};


   PROCEDURE MergeModes1 (VAR SrcOp, DestOp : OPERAND;
                          VAR ObjOp, ObjSrc, ObjDest : LONG;
                          VAR nO,    nS,     nD      : CARDINAL);
   (*  Uses information from Instructions & GetOperand (among others)  *)
   (*  to complete calculation of Object Code.                         *)
   (*  Op, AddrModeA, AddrModeB, Size, and Src & Dest records are all  *)
   (*  Global variables imported from the SyntaxAnalyzer MODULE.       *)

      BEGIN
         Quick := FALSE;

         (* Check for 5 special cases first *)

         IF (Op = RTE) OR (Op = RTR) OR (Op = RTS) OR (Op = TRAPV) THEN
            IF Src.Mode # Null THEN
               Error (SrcLoc, OperErr);
            END;
         END;

         IF Op = STOP THEN
            IF (Src.Mode # Imm) OR (Dest.Mode # Null) THEN
               Error (SrcLoc, OperErr);
            END;
         END;

         IF Op = LINK THEN
            Op := Op + BITSET (Src.Rn);
            IF (Src.Mode # ARDir) OR (Dest.Mode # Imm) THEN
               Error (SrcLoc, ModeErr);
            END;
         END;

         IF Op = SWAP THEN
            IF EA05f IN AddrModeB THEN
               (* Ignore, this is PEA instruction! *)
            ELSE
               Op := Op + BITSET (Src.Rn);
               IF (Src.Mode # DReg) OR (Dest.Mode # Null) THEN
                  Error (SrcLoc, OperErr);
               END;
            END;
         END;

         IF Op = UNLK THEN
            Op := Op + BITSET (Src.Rn);
            IF (Src.Mode # ARDir) OR (Dest.Mode # Null) THEN
               Error (SrcLoc, OperErr);
            END;
         END;

         (* Now do generalized address modes *)

         IF (Ry02 IN AddrModeA) AND (Rx911 IN AddrModeA) THEN
            Op := Op + BITSET (Src.Rn) + BITSET (Dest.Rn * 512);
            (* Now do some error checking! *)
            IF RegMem3 IN AddrModeA THEN
               IF Src.Mode = DReg THEN
                  IF Dest.Mode # DReg THEN
                     Error (DestLoc, ModeErr);
                  END;
               ELSIF Src.Mode = ARPre THEN
                  Op := Op + {3};
                  IF Dest.Mode # ARPre THEN
                     Error (DestLoc, ModeErr);
                  END;
               ELSE
                  Error (SrcLoc, OperErr);
               END;
            ELSE
               IF Src.Mode = ARPost THEN
                  IF Dest.Mode # ARPost THEN
                     Error (DestLoc, ModeErr);
                  END;
               ELSE
                  Error (SrcLoc, OperErr);
               END;
            END;
         END;

         IF Data911 IN AddrModeA THEN
            Quick := TRUE;
            IF Src.Mode = Imm THEN
               IF LongToInt (Src.Value, TempI)
                AND (TempI > 0)
                 AND (TempI <= 8) THEN
                  IF TempI < 8 THEN   (* Data of 8 is coded as 000 *)
                     Op := Op + BITSET (TempI * 512);
                  END;
               ELSE
                  Error (SrcLoc, SizeErr);
               END;
            ELSE
               Error (SrcLoc, OperErr);
            END;
         END;

         IF CntR911 IN AddrModeA THEN
            (* Only Shift/Rotate use this *)
            IF Dest.Mode = DReg THEN
               Op := (Op * Off910) + BITSET (Dest.Rn);
               CASE Size OF
                  Byte : ;
               |  Word : Op := Op + {6};
               |  Long : Op := Op + {7};
               END;
               IF Src.Mode = DReg THEN
                  Op := Op + {5} + BITSET (Src.Rn * 512);
               ELSIF Src.Mode = Imm THEN
                  Quick := TRUE;
                  (* Range Check *)
                  IF LongToInt (Src.Value, TempI)
                   AND (TempI > 0)
                    AND (TempI <= 8) THEN
                     IF TempI < 8 THEN   (* Data of 8 is coded as 000 *)
                        Op := Op + BITSET (TempI * 512);
                     END;
                  ELSE
                     Error (SrcLoc, SizeErr);
                  END;
               ELSE
                  Error (SrcLoc, OperErr);
               END;
            ELSIF Dest.Mode = Null THEN
               Op := (Op * Off34) + {7, 6};
               EffAdr (Src, (mea + aea));
            ELSE
               Error (SrcLoc, OperErr);
            END;
         END;
      END MergeModes1;



   PROCEDURE MergeModes2 (VAR SrcOp, DestOp : OPERAND;
                          VAR ObjOp, ObjSrc, ObjDest : LONG;
                          VAR nO,    nS,     nD      : CARDINAL);

      BEGIN
         IF Data03 IN AddrModeA THEN
            Quick := TRUE;
            IF Src.Mode = Imm THEN
               IF LongToInt (Src.Value, TempI)
                AND (TempI >= 0)
                 AND (TempI < 16) THEN
                  Op := Op + BITSET (TempI);
               ELSE
                  Error (SrcLoc, SizeErr);
               END;
            ELSE
               Error (SrcLoc, OperErr);
            END;
         END;

         IF Data07 IN AddrModeA THEN
            Quick := TRUE;
            IF (Src.Mode = Imm) AND (Dest.Mode = DReg) THEN
               IF LongToInt (Src.Value, TempI)
                AND (TempI >= -128)
                 AND (TempI <= 127) THEN
                  Op := Op + (BITSET (TempI) * {7, 6, 5, 4, 3, 2, 1, 0})
                           + BITSET (Dest.Rn * 512);
               ELSE
                  Error (SrcLoc, SizeErr);
               END;
            ELSE
               Error (SrcLoc, OperErr);
            END;
         END;

         IF OpM68D IN AddrModeA THEN
            IF Dest.Mode = DReg THEN
               Op := Op + BITSET (Dest.Rn * 512);
               IF (Src.Mode = ARDir) AND (Size = Byte) THEN
                  Error (SrcLoc, SizeErr);
               END;
            ELSE   (* Assume Src.Mode = DReg -- Error trapped elsewhere *)
               Op := Op + BITSET (Src.Rn * 512);
               Op := Op + {8};
            END;

            CASE Size OF
               Byte : ;
            |  Word : Op := Op + {6};
            |  Long : Op := Op + {7};
            END;
         END;

         IF OpM68A IN AddrModeA THEN
            IF Dest.Mode = ARDir THEN
               Op := Op + BITSET (Dest.Rn * 512);
            ELSE
               Error (DestLoc, ModeErr);
            END;

            CASE Size OF
               Byte : Error (OpLoc, SizeErr);
            |  Word : Op := Op + {7, 6};
            |  Long : Op := Op + {8, 7, 6};
            END;
         END;

         IF OpM68C IN AddrModeA THEN
            IF Dest.Mode = DReg THEN
               Op := Op + BITSET (Dest.Rn * 512);
            ELSE
               Error (DestLoc, ModeErr);
            END;

            CASE Size OF
               Byte : IF Src.Mode = ARDir THEN
                         Error (OpLoc, SizeErr);
                      END;
            |  Word : Op := Op + {6};
            |  Long : Op := Op + {7};
            END;
         END;

         IF OpM68X IN AddrModeA THEN
            IF Src.Mode = DReg THEN
               Op := Op + BITSET (Src.Rn * 512);
            ELSE
               Error (SrcLoc, ModeErr);
            END;

            CASE Size OF
               Byte : Op := Op + {8};
            |  Word : Op := Op + {8, 6};
            |  Long : Op := Op + {8, 7};
            END;
         END;

         IF OpM68S IN AddrModeA THEN
            IF Src.Mode = DReg THEN
               Op := Op + BITSET (Src.Rn);
            ELSE
               Error (SrcLoc, ModeErr);
            END;

            CASE Size OF
               Byte : Error (OpLoc, SizeErr);
            |  Word : Op := Op + {7};
            |  Long :   Op := Op + {7, 6};
            END;
         END;
      END MergeModes2;



   PROCEDURE MergeModes3 (VAR SrcOp, DestOp : OPERAND;
                          VAR ObjOp, ObjSrc, ObjDest : LONG;
                          VAR nO,    nS,     nD      : CARDINAL);

      BEGIN
         IF OpM68R IN AddrModeA THEN
            IF (Src.Mode = DReg) AND (Dest.Mode = ARDisp) THEN
               CASE Size OF
                  Byte : Error (OpLoc, SizeErr);
               |  Word : Op := Op + {8, 7};
               |  Long : Op := Op + {8, 7, 6};
               END;
               Op := Op + BITSET (Src.Rn * 512) + BITSET (Dest.Rn);
            ELSIF (Src.Mode = ARDisp) AND (Dest.Mode = DReg) THEN
               CASE Size OF
                  Byte : Error (OpLoc, SizeErr);
               |  Word : Op := Op + {8};
               |  Long : Op := Op + {8, 6};
               END;
               Op := Op + BITSET (Src.Rn) + BITSET (Dest.Rn * 512);
            ELSE
               Error (SrcLoc, ModeErr);
            END;
         END;

         IF OpM37 IN AddrModeA THEN
            IF (Src.Mode = DReg) AND (Dest.Mode = DReg) THEN
               Op := Op + {6} + BITSET (Src.Rn * 512) + BITSET (Dest.Rn);
            ELSIF (Src.Mode = ARDir) AND (Dest.Mode = ARDir) THEN
               Op := Op + {6, 3} + BITSET (Src.Rn * 512) + BITSET (Dest.Rn);
            ELSIF (Src.Mode = ARDir) AND (Dest.Mode = DReg) THEN
               Op := Op + {7, 3} + BITSET (Dest.Rn * 512) + BITSET (Src.Rn);
            ELSIF (Src.Mode = DReg) AND (Dest.Mode = ARDir) THEN
               Op := Op + {7, 3} + BITSET (Src.Rn * 512) + BITSET (Dest.Rn);
            ELSE
               Error (SrcLoc, ModeErr);
            END;
         END;

         IF Bit811 IN AddrModeB THEN
            IF Src.Mode = DReg THEN
               Op := Op + {8} + BITSET (Src.Rn * 512);
            ELSIF Src.Mode = Imm THEN
               Op := Op + {11};
            ELSE
               Error (SrcLoc, ModeErr);
            END;
         END;

         IF Size67 IN AddrModeB THEN
            CASE Size OF
               Byte : ;(* No action -- bits already 0's *)
            |  Word : Op := Op + {6};
            |  Long : Op := Op + {7};
            END;
         END;

         IF Size6 IN AddrModeB THEN
            CASE Size OF
               Byte : Error (OpLoc, SizeErr);
            |  Word : (* No Action -- BIT is already 0 *)
            |  Long : Op := Op + {6};
            END;
         END;

         IF Size1213A IN AddrModeB THEN
            CASE Size OF
               Byte : Op := Op + {12};
            |  Word : Op := Op + {13, 12};
            |  Long : Op := Op + {13};
            END;
         END;

         IF Size1213 IN AddrModeB THEN
            Op := Op + BITSET (Dest.Rn * 512);
            CASE Size OF
               Byte : Error (OpLoc, SizeErr);
            |  Word : Op := Op + {13, 12};
            |  Long : Op := Op + {13};
            END;
         END;

         IF EA05a IN AddrModeB THEN
            IF (Dest.Mode = DReg) OR (Dest.Mode = ARDir) THEN
               EffAdr (Src, ea);
            ELSE
               Error (DestLoc, ModeErr);
            END;
         END;

         IF EA05b IN AddrModeB THEN
            IF Dest.Mode = DReg THEN
               EffAdr (Src, dea);
               Op := Op + BITSET (Dest.Rn * 512);
            ELSE
               Error (DestLoc, ModeErr);
            END;
         END;
      END MergeModes3;



   PROCEDURE MergeModes4 (VAR SrcOp, DestOp : OPERAND;
                          VAR ObjOp, ObjSrc, ObjDest : LONG;
                          VAR nO,    nS,     nD      : CARDINAL);

      VAR
         M : CARDINAL;
         i : CARDINAL;
         Ext : BITSET;      (* Bit pattern for instruction extension word *)
         ExtL : LONG;

      BEGIN
         ExtL := LZero;

         IF EA05c IN AddrModeB THEN
            EffAdr (Dest, {11, 1});
         END;

         IF EA05d IN AddrModeB THEN
            EffAdr (Dest, aea);
            IF (Dest.Mode = ARDir) AND (Size = Byte) THEN
               Error (OpLoc, SizeErr);
            END;
         END;

         IF EA05e IN AddrModeB THEN
            IF Dest.Mode = Null THEN
               EffAdr (Src, (dea + aea));
            ELSIF (Src.Mode = Imm) OR (Src.Mode = DReg) THEN
               EffAdr (Dest, (dea + aea));
            ELSE
               Error (SrcLoc, ModeErr);
            END;
         END;

         IF EA05f IN AddrModeB THEN   (* LEA & PEA / JMP & JSR *)
            EffAdr (Src, cea);
            IF Rx911 IN AddrModeA THEN
               IF Dest.Mode = ARDir THEN
                  Op := Op + BITSET (Dest.Rn * 512);
               ELSE
                  Error (DestLoc, ModeErr);
               END;
            ELSE
               IF Dest.Mode # Null THEN
                  Error (DestLoc, OperErr);
               END;
            END;
         END;

         IF EA05x IN AddrModeB THEN
            IF Dest.Mode = DReg THEN
               EffAdr (Src, dea);
            ELSIF Src.Mode = DReg THEN
               EffAdr (Dest, mea + aea);
            ELSE
               Error (SrcLoc, OperErr);
            END;
         END;

         IF EA05y IN AddrModeB THEN
            IF Dest.Mode = DReg THEN
               EffAdr (Src, ea);
               IF (Src.Mode = ARDir) AND (Size = Byte) THEN
                  Error (OpLoc, SizeErr);
               END;
            ELSIF Src.Mode = DReg THEN
               EffAdr (Dest, (mea + aea));
            ELSE
               Error (SrcLoc, ModeErr);
            END;
         END;

         IF EA05z IN AddrModeB THEN
            IF Src.Mode = MultiM THEN
               EffAdr (Dest, (mea + aea + {3}));
               GetMultReg (SrcOp, (Dest.Mode = ARPre), SrcLoc, Ext);
            ELSIF Dest.Mode = MultiM THEN
               EffAdr (Src, (mea + {11, 4}));
               GetMultReg (DestOp, (Src.Mode = ARPre), DestLoc, Ext);
               Op := Op + {10};   (* set direction *)
            ELSE
               Error (SrcLoc, OperErr);
            END;

            INC (nO, 4);   (* extension is part of OpCode *)
            INC (InstSize, 2);
            CardToLong (CARDINAL (Ext), ExtL);
         END;

         IF EA611 IN AddrModeB THEN
            IF Dest.Mode = CCR THEN
               Op := {14, 10, 7, 6};
               EffAdr (Src, dea);
            ELSIF Dest.Mode = SR THEN
               Op := {14, 10, 9, 7, 6};
               EffAdr (Src, dea);
            ELSIF Src.Mode = SR THEN
               Op := {14, 7, 6};
               EffAdr (Dest, dea + aea);
            ELSIF Dest.Mode = USP THEN
               Op := {14, 11, 10, 9, 6, 5};
               IF Src.Mode = ARDir THEN
                  Op := Op + BITSET (Src.Rn);
               ELSE
                  Error (SrcLoc, ModeErr);
               END;
            ELSIF Src.Mode = USP THEN
               Op := {14, 11, 10, 9, 6, 5, 3};
               IF Dest.Mode = ARDir THEN
                  Op := Op + BITSET (Dest.Rn);
               ELSE
                  Error (DestLoc, ModeErr);
               END;
            ELSE
               EffAdr (Src, (ea + xxx));
               IF (Size = Byte) AND (Src.Mode = ARDir) THEN
                  Error (SrcLoc, SizeErr);
               END;

               M := ORD (Dest.Mode);
               IF (M IN (dea + aea)) OR (M > 11) THEN
                  Error (DestLoc, ModeErr);
               ELSIF M < 7 THEN
                  Op := Op + BITSET (M * 64) + BITSET (Dest.Rn * 512);
               ELSE   (*  7  <=  M  <=  11  *)
                  Op := Op + {8, 7, 6} + BITSET ((M - 7) * 512);
               END;

               OperExt (Dest);
            END;
         END;

         IF (Dest.Mode = CCR) AND (Src.Mode = Imm) THEN
            IF (Size67 IN AddrModeB)
             AND (EA05e IN AddrModeB)
              AND (Exten IN AddrModeB) THEN
               IF 10 IN Op THEN   (* NOT ANDI/EORI/ORI *)
                  Error (DestLoc, ModeErr);
               ELSE
                  Op := Op * {15, 14, 13, 12, 11, 10, 9, 8};   (* AND mask *)
                  Op := Op + {5, 4, 3, 2};                     (*  OR mask *)
               END;
            END;
         END;

         IF (Dest.Mode = SR) AND (Src.Mode = Imm) THEN
            IF (Size67 IN AddrModeB)
             AND (EA05e IN AddrModeB)
              AND (Exten IN AddrModeB) THEN
               IF 10 IN Op THEN   (* NOT ANDI/EORI/ORI *)
                  Error (DestLoc, ModeErr);
               ELSE
                  Op := Op * {15, 14, 13, 12, 11, 10, 9, 8};   (* AND mask *)
                  Op := Op + {6, 5, 4, 3, 2};                  (*  OR mask *)
               END;
            END;
         END;

         CardToLong (CARDINAL (Op), ObjOp);
         INC (InstSize, 2);
         INC (nO, 4);
         IF nO > 4 THEN
            FOR i := 1 TO 4 DO   (* move ObjOp -- make room for extension *)
               ObjOp[i + 4] := ObjOp[i];
               ObjOp[i] := ExtL[i];
            END;
         END;

         nS := GetInstModeSize (Src.Mode, Size, InstSize);
         ObjSrc := Src.Value;
         nD := GetInstModeSize (Dest.Mode, Size, InstSize);
         ObjDest := Dest.Value;

         IF Quick THEN
            InstSize := 2;
            nS := 0;   nD := 0;
         END;
         CardToLong (InstSize, AddrAdv);

      END MergeModes4;



   TYPE
      DirType = (None, Org, Equ, DC, DS, Even, End);

   PROCEDURE ObjDir (OpCode : TOKEN; SrcOp : OPERAND; Size : SizeType;
                     VAR AddrCnt, ObjOp, ObjSrc, ObjDest : LONG;
                     VAR   nA,      nO,    nS,     nD    : CARDINAL) : DirType;
   (* Generates Object Code for Assembler Directives *)

      VAR
         Dir : DirType;
         i, j : CARDINAL;
         LongString : ARRAY [1..20] OF INTEGER;

      BEGIN
         AddrAdv := LZero;

         IF CompareStr (OpCode, "ORG") = 0 THEN
            GetValue (SrcOp, AddrCnt);
            AddrBoundW (AddrCnt);
            Dir := Org;
         ELSIF CompareStr (OpCode, "EQU") = 0 THEN
            GetValue (SrcOp, ObjSrc);
            nS := 8;
            Dir := Equ;
         ELSIF CompareStr (OpCode, "DC") = 0 THEN
            CASE Size OF
               Word  :  AddrBoundW (AddrCnt);
            |  Long  :  AddrBoundL (AddrCnt);
            |  Byte  :  ;
            END;

            IF SrcOp[0] = Quote THEN   (* String constant *)
               TempC := Length (SrcOp);
               IF TempC > 2 THEN
                  InstSize := TempC - 2;   (* Don't count the Quotes *)
               END;

               i := 1;   j := 20;
               WHILE i <= InstSize DO   (* Change from ASCII to LONG *)
                  CardToLong (ORD (SrcOp[i]), TempL);
                  LongString[j] := TempL[2];
                  LongString[j - 1] := TempL[1];
                  INC (i);   DEC (j, 2);
               END;

               i := 1;   INC (j);
               WHILE j <= 20 DO   (* Left Justify String *)
                  LongString[i] := LongString[j];
                  INC (i);   INC (j);
               END;

               DEC (i);
               WHILE i > 16 DO   (* Transfer 2 bytes to OpCode *)
                  ObjOp[i - 16] := LongString[i];
                  INC (nO);   DEC (i);
               END;

               WHILE i > 8 DO   (* Transfer 4 bytes to Source Operand *)
                  ObjSrc[i - 8] := LongString[i];
                  INC (nS);   DEC (i);
               END;

               WHILE i > 0 DO   (* Transfer 4 bytes to Destination Operand *)
                  ObjDest[i] := LongString[i];
                  INC (nD);   DEC (i);
               END;

               IF SrcOp[InstSize + 1] # Quote THEN
                  Error ((SrcLoc + InstSize + 1), OperErr);
               END;
            ELSE   (* not a string constant *)
               GetValue (SrcOp, ObjSrc);
               InstSize := ORD (Size);
               nS := InstSize * 2;
            END;
            CardToLong (InstSize, AddrAdv);
            nA := 6;
            Dir := DC;
         ELSIF CompareStr (OpCode, "DS") = 0 THEN
            GetValue (SrcOp, AddrAdv);
            nA := 6;   nS := 2;   ObjSrc := LZero;
            Dir := DS;
         ELSIF CompareStr (OpCode, "EVEN") = 0 THEN
            AddrBoundW (AddrCnt);
            Dir := Even;
         ELSIF CompareStr (OpCode, "END") = 0 THEN
            nA := 6;
            Dir := End;
         ELSE
            Dir := None;
         END;

         RETURN (Dir);
      END ObjDir;



   PROCEDURE AdvAddrCnt (VAR AddrCnt : LONG);
   (* Advances the address counter based on the length of the instruction *)
      BEGIN
         LongAdd (AddrCnt, AddrAdv, AddrCnt);
      END AdvAddrCnt;



   PROCEDURE GetObjectCode (Label, OpCode : TOKEN;
                            SrcOp, DestOp : OPERAND;
                            VAR AddrCnt, ObjOp, ObjSrc, ObjDest : LONG;
                            VAR   nA,      nO,    nS,     nD    : CARDINAL);
   (* Determines the object code for the operation as well as the operands *)
   (* Returns each (up to 3 fields), along with the length of each.        *)

      VAR
         Dummy : BOOLEAN;
         Dir : DirType;

      BEGIN
         AddrAdv := LZero;
         InstSize := 0;
         nA := 0;   nO := 0;   nS := 0;   nD := 0;

         IF Length (OpCode) = 0 THEN
            (* ensure no code generated *)
            RETURN;
         END;

         GetSize (OpCode, Size);

         Dir := ObjDir (OpCode, SrcOp, Size,
                        AddrCnt, ObjOp, ObjSrc, ObjDest,
                          nA,      nO,    nS,     nD    );

         IF (Length (Label) # 0) AND (Dir # Equ) THEN
         (* Check for phase error *)
            Dummy := ReadSymTab (Label, TempL, Dummy);
            IF LongCompare (TempL, AddrCnt) # 0 THEN
               Error (0, Phase);
            END;
         END;

         IF Dir = None THEN   (* Instruction *)
            AddrBoundW (AddrCnt);
         ELSE
            RETURN;
         END;

         Instructions (OpCode, OpLoc, Op, AddrModeA, AddrModeB);
         Src.Loc := SrcLoc;   Dest.Loc := DestLoc;
         GetOperand (SrcOp, Src);   (* Src & Dest are RECORDS *)
         GetOperand (DestOp, Dest);

         IF DecBr IN AddrModeA THEN   (* Decrement & Branch *)
            IF Src.Mode # DReg THEN
               Error (SrcLoc, ModeErr);
            END;

            BrValue := Dest.Value;
            TempL := AddrCnt;
            TempC := 32767;   (* Maximum Branch *)
            LongInc (TempL, 2);   (* move past instruction for Rel Adr Calc *)

            IF LongCompare (BrValue, TempL) < 0 THEN
               RevBr := TRUE;
               LongSub (TempL, BrValue, BrValue);
               INC (TempC);   (* can branch 1 farther in reverse *)
            ELSE
               RevBr := FALSE;
               LongSub (BrValue, TempL, BrValue);
            END;

            CardToLong (TempC, TempL);   (* Maximum Branch distance *)

            IF LongCompare (BrValue, TempL) > 0 THEN
               Error (DestLoc, BraErr);
            END;
            IF RevBr THEN   (* Make Negative *)
               LongSub (LZero, BrValue, BrValue)
            END;

            CardToLong (4, AddrAdv);
            nA := 6;   nO := 4;   nS := 4;
            CardToLong (CARDINAL (Op + BITSET (Src.Rn)), ObjOp);
            ObjSrc := BrValue;
            RETURN;
         END;

         IF Brnch IN AddrModeA THEN   (* Branch *)
            BrValue := Src.Value;   (* Destination of Branch *)
            TempL := AddrCnt;
            LongInc (TempL, 2);

            IF Size # Byte THEN   (* Byte Size ---> Short Branch *)
               TempC := 32767;   (* Set maximum branch distance *)
            ELSE
               TempC := 127;
            END;

            CASE LongCompare (BrValue, TempL) OF
               -1 :  (* Reverse Branch *)
                     RevBr := TRUE;
                     INC (TempC);   (* can branch 1 farther in reverse *)
                     LongSub (TempL, BrValue, BrValue);
            |  +1 :  (* Forward Branch *)
                     RevBr := FALSE;
                     LongSub (BrValue, TempL, BrValue);
            |   0 :  IF Size = Byte THEN
                        Error (SrcLoc, BraErr);
                     END;
            END;

            CardToLong (TempC, TempL);

            IF LongCompare (BrValue, TempL) > 0 THEN
               Error (SrcLoc, BraErr);
            END;

            IF RevBr THEN
               LongSub (LZero, BrValue, BrValue);   (* Make negative *)
            END;

            IF Size # Byte THEN
               InstSize := 4;
               nS := 4;
               ObjSrc := BrValue;
            ELSE
               InstSize := 2;
               Dummy := LongToInt (BrValue, TempI);
               Op := Op + (BITSET (TempI) * {7, 6, 5, 4, 3, 2, 1, 0});
            END;

            nA := 6;   nO := 4;
            CardToLong (InstSize, AddrAdv);
            CardToLong (CARDINAL (Op), ObjOp);
            RETURN;
         END;

         nA := 6;
         IF (Op = JMP) OR (Op = JSR) THEN   (* Allows for 'JMP.S' *)
            IF (Size = Byte) AND (Src.Mode = AbsL) THEN
               Src.Mode := AbsW;
            END;
         END;

         (* Due to implementation restrictions on the size of procedures, *)
         (* MergeModes on the LogiTech version had to be split into  four *)
         MergeModes1 (SrcOp, DestOp, ObjOp, ObjSrc, ObjDest, nO, nS, nD);
         MergeModes2 (SrcOp, DestOp, ObjOp, ObjSrc, ObjDest, nO, nS, nD);
         MergeModes3 (SrcOp, DestOp, ObjOp, ObjSrc, ObjDest, nO, nS, nD);
         MergeModes4 (SrcOp, DestOp, ObjOp, ObjSrc, ObjDest, nO, nS, nD);
      END GetObjectCode;


BEGIN   (* MODULE Initialization *)
   LongClear (LZero);   (* Used as a constant *)
   AddrCnt := LZero;
   Pass2 := FALSE;
END CodeGenerator.